home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / madtrb13.arc / NOFLASH2.PAS < prev    next >
Pascal/Delphi Source File  |  1986-02-06  |  14KB  |  361 lines
  1. {This program was originally obtained from a bulletin board.  The original
  2. author is unknown.  During the course of analyzing how various functions
  3. were accomplished, a number of changes were made.  The most notable of
  4. these are as follows:
  5. 1)  The shadow that follows the word LYNN down the screen.  This originally
  6.     was the word TEST, but I decided it was more fun to see my name on the
  7.     screen.  Programmer vanity I suppose.
  8. 2)  The routines associated with the "face".
  9. 3)  The addition of color.
  10. 4)  Various delays to slow the action.
  11. 5)  Extensive Documentation.
  12. Note for Monochrome users:  Be sure to change the parameters noted.  It
  13.        may be necessary to change the attribute bytes to a value of 15 (White)
  14.        in order to see everything.
  15.  
  16. Being a novice at Turbo Pascal, some of the assumptions made in the
  17. documentation are probably not technically correct.  If you find something
  18. wrong or if you can tell me how the "port" array addresses are determined
  19. or what the actual definition of the "^" in the update
  20. procedure is, please let me know.  Hopefully this program and the
  21. documentation will provide some insight into screen updating.
  22. Lynn Canning, 9107 Grandview, Overland Park, Ks. 66212 }
  23.  
  24. {$u-}   {Turn off CNTL C interupts}
  25. {$c-}   {Turn off CNTL C & S}
  26. {$u-}   {I don't know why there are two sets of these.  See Appendix}
  27. {$c-}   { E, Version 2.0 of the Turbo Pascal Reference Manual}
  28. {$x+}   {Maximize array generation}
  29. {$k-}   {Turn off stack checking}
  30. const
  31.   time_array : array[1..7] of array[1..50] of char =
  32.  
  33.     ('~~~          ~~      ~~   ~~      ~~   ~~      ~~ ',
  34.      '~~~           ~~    ~~    ~~~     ~~   ~~~     ~~ ',
  35.      '~~~            ~~ ~~      ~~ ~~   ~~   ~~ ~~   ~~ ',
  36.      '~~~             ~~        ~~  ~~  ~~   ~~  ~~  ~~ ',
  37.      '~~~             ~~        ~~   ~~ ~~   ~~   ~~ ~~ ',
  38.      '~~~~~~~~~~~     ~~        ~~     ~~~   ~~     ~~~ ',
  39.      '~~~~~~~~~~~     ~~        ~~      ~~   ~~      ~~ ');
  40.  
  41. type
  42.   char_cell   = record
  43.                   code : char;
  44.                   attr : byte;
  45.                   end;
  46.  
  47.   screen_type = array[1..25] of array[1..80] of char_cell;
  48.  
  49. var
  50.   ch          : char;
  51.   i,j,k,l,m,n : byte;
  52.   screen      : screen_type;
  53.   real_screen : ^screen_type;
  54.   mode        : integer;
  55.  
  56. {The lines above define the arrays used.  The "^" in ^screen_type
  57.  defines the array real_screen as actual screen memory.  Screen is
  58.  the array used as a work area and is the RAM or virtual screen.
  59.  When everything is defined as desired, the changed portions are
  60.  moved to screen memory via the port array.
  61.  Note the record definition.  The value of "code" is the actual value
  62.  to be shown.  The value of "attr" may have additional purposes, but
  63.  is used to define the color of "code".  If this is not populated for
  64.  a particular coordinate, nothing will show on the screen even if the
  65.  "code" is populated.}
  66.  
  67. {Procedure "Update" moves the data from the screen work array to
  68.  screen memory.  You can change things as much as you want in the
  69.  work array, but if you don't move it to screen memory, by
  70.  executing "Update" nothing changes on the screen.
  71.  As previously stated, I don't understand how the port array
  72.  addresses are determined or exactly how the value "^" defines
  73.  the actual screen memory.  Since mode is set to "2" for a color
  74.  monitor, apparently the data must be sent to the screen port for
  75.  display.  Direct updating to the screen apparently can be done with
  76.  a monochrome monitor.  The value of "y" identifies which screen line
  77.  to begin moving, while the value of "lines" identifies the number
  78.  of lines to move.  If you want to update lines 17,18 & 19, y would
  79.  be set at 17 and lines would be set at 3.  Note that both the "code"
  80.  and "attr" values must be moved to the 80 character display screen,
  81.  hence the value of 160 in the move statement.}
  82.  
  83. procedure update_screen(y,lines : byte);
  84.  
  85.   begin
  86.   if mode <> 1 then
  87.     repeat until (port[$3da] and 8) = 8;
  88.   if mode <> 1 then
  89.     port[$3d8] := 1;
  90.   move(screen[y],real_screen^[y],lines * 160);
  91.   if mode <> 1 then
  92.     port[$3d8] := 9;
  93.   end;
  94.  
  95. {Procedure "Read" is the opposite of "Update".  It reads from the screen
  96.  memory array into the work array.  I can't see that it actually does anything
  97.  in this program.}
  98.  
  99. procedure read_screen(y,lines : byte);
  100.  
  101.   begin
  102.   if mode <> 1 then
  103.     repeat until (port[$3da] and 8) = 8;
  104.   if mode <> 1 then
  105.     port[$3d8] := 1;
  106.   move(real_screen^[y],screen[y],lines * 160);
  107.   if mode <> 1 then
  108.     port[$3d8] := 9;
  109.   end;
  110.  
  111. {Procedure "March" defines and moves "This is not a test" down the
  112.  left and right side of the screen.  How this is accomplished can be
  113.  more easily understood by noting how the face moves in the "face"
  114.  routines.  "March" contains the embedded procedures "Position" &
  115.  "Print".}
  116.  
  117. procedure march;
  118.  
  119. const first_half  : string[18] = 'n si sihT         ';
  120.       second_half : string[18] = 'ot a test         ';
  121.  
  122. var i,j : byte;
  123.     ch  : char;
  124.  
  125.  
  126. procedure position(i : integer;
  127.                    var x,y : byte);
  128. begin
  129.   if i <= 16                   {                                       }
  130.   then begin                   {Defines x & y for marching down left & }
  131.          x := 1;               {right of screen                        }
  132.          y := i;               {                                       }
  133.        end
  134.   else begin
  135.          x := i - 16;          {Defines x & y for marching across      }
  136.          y := 17;              {line 17                                }
  137.        end;
  138. end;
  139.  
  140. procedure print(num : byte);
  141. var x,y,
  142.     j,k,l : byte;
  143.     i     : integer;
  144. begin
  145.   j := 0;
  146.   for i := num downto num - 17 do
  147.     if i > 0
  148.     then begin
  149.            j := j + 1;
  150.            position(i,x,y);
  151.            screen[y,x].code := first_half[j];
  152.            screen[y,81 - x].code := second_half[j];
  153.            if y < 16 then
  154.              k := y
  155.            else
  156.              k := k + 1;
  157.            if k = 16 then
  158.              k := 1;
  159.            l := k - 1;
  160.            if l = 0 then
  161.              l := 1;
  162.            if (k = 1) and (mode = 1) then
  163.              k := 2;
  164.            if (k = 9) and (mode = 1) then
  165.              k := 10;
  166.            screen[y,x].attr := k;
  167.            screen[y,81 - x].attr := l;
  168.          end;
  169.  
  170.   if y < 17 then
  171.     begin
  172.     update_screen(1,8);
  173.     update_screen(8,8);
  174.     update_screen(16,8);
  175. delay(100);
  176.     end
  177.   else
  178.     update_screen(y,1);
  179. end;
  180.  
  181. begin
  182.   for i := 1 to 56 do            {BEGIN for procedure march}
  183.     print(i);
  184.   delay(500);
  185. end;
  186.  
  187.  
  188. begin
  189.  
  190.   ClrScr;
  191.   real_screen := ptr($b800,0);   {change to $b800 for color, $b000 for mono}
  192.   fillchar(screen,4000,0);       {initializes the screen work array to 0}
  193.   mode := 2;                     {change to 2 for color, 1 for mono}
  194.  
  195.   for i := 1 to 50 do                      {Display initial banner}
  196.     for j := 1 to 7 do
  197.       begin
  198.       screen[j,i].code := time_array[j,i]; 
  199.       screen[j,i].attr := j;            {set color for banner}
  200.       end;
  201.  
  202.   update_screen(1,8);
  203.  
  204.   for i := 1 to 8 do          {This routine moves the banner down the }
  205.     begin                     {screen one line at a time.             }
  206.     for j := 7 downto 0 do    {                                       }
  207.       begin
  208.       move(screen[j + i],screen[j + i + 1],120);
  209. {     fillchar(screen[j + i],120,0);}{removal of this line allowed the}
  210.       end;                           {shadow to remain on the screen}
  211.     update_screen(i,8);
  212.     delay(25);
  213.     end;
  214.  
  215.  for i := 1 to 8 do begin      {                                       }
  216.    fillchar(screen[i],120,0);  {This routine was inserted in place of  }
  217.    update_screen(i,8);         {the fillchar line above.  It removes   }
  218.    delay(25);                  {the shadow left on the screen.         }
  219.    end;                        {The fillchar command is used to overlay} 
  220.   delay(500);                  {residual data left from a previous move}
  221.  
  222. {Tilting, Untilting and Centering the banner is accomplished by moving
  223.  the line left or right a certain number of characters.  This will cause
  224.  screen wrap.  If you increase the length of the banner, the screen wrap
  225.  may in fact overlay some of the banner.  The way around this would be to
  226.  move only the actual number of characters involved thus eliminating the
  227.  wrapping problem.  Evidence of the wrap can be seen by changing the zero
  228.  in the fillchar statement to another character, say 1.}
  229.  
  230.   for i := 9 downto 1 do                       {Tilt banner}
  231.     begin
  232.     move(screen[i + 8,1],screen[i + 8,11 - i],120);
  233.     fillchar(screen[i + 8,1],19 - (2 * i),0);
  234.     end;
  235.  
  236.   update_screen(8,8);
  237.   delay(250);
  238.  
  239.   for k := 1 to 14 do                      {Center banner}
  240.     begin
  241.     for j := 9 to 17 do
  242.       move(screen[j,k],screen[j,k + 1],120);
  243.     update_screen(8,8);
  244.     end;
  245.  
  246.   for i := 9 downto 1 do                       {UnTilt banner}
  247.     move(screen[i + 8,11 - i],screen[i + 8,1],160);
  248.   update_screen(8,8);
  249.  
  250.   march;                                  {Bring in the rest of the title}
  251.  
  252. {---------------------------------------------------------------------------}
  253. {                           FACE Routines}
  254. fillchar(screen[1,1],1,2);                   {define face at coord 1,1}
  255. update_screen(1,1);
  256. for k := 1 to 15 do     {move face down left of screen to line 16}
  257.     begin                                    
  258.      move(screen[k,1],screen[k + 1,1],1);    {move face down one line}
  259.      screen[k + 1,1].attr := 6;              {set face color to brown}
  260.      fillchar(screen[k,1],1,0);              {fill in behind face}
  261.      update_screen(1,8);
  262.      update_screen(8,8);                     {display current face position}
  263.      update_screen(16,8);                    {on screen}
  264.      delay(100);
  265.      end;
  266. for k := 1 to 39 do      {move face across line 16 to col 40}
  267.     begin
  268.      move(screen[16,k],screen[16,k + 1],1); {move face right one column}
  269.      screen[16,k + 1].attr := 6;            {set face color to brown} 
  270.      fillchar(screen[16,k],1,0);            {fill in behind face}
  271.      update_screen(16,1);        {display current face position of screen}
  272.      end;
  273. for k := 40 to 42 do            {kick "not" down to line 18}
  274.   begin
  275.   move(screen[17,k],screen[18,k],1);      {move letter at pos k to line 18}
  276.   screen[18,k].attr := screen[17,k].attr; {maintain same color}
  277.   move(screen[16,k],screen[17,k],1);      {duplicate face in line 17}
  278.   update_screen(16,3);                    {update lines 16-18}
  279.   fillchar(screen[17,k],1,0);             {blank out face in line 17}
  280.   update_screen(17,1);                    {update line 17}
  281.   delay(200);
  282.   move(screen[16,k],screen[16,k + 1],1);  {move face 1 position to right}
  283.   screen[16,k + 1].attr := 6;             {maintain same face color}
  284.   fillchar(screen[16,k],1,0);             {blank out previous face}
  285.   update_screen(16,1);                    {update line 16}
  286.   end;                                    {continue until 3 letters kicked}
  287. for k :=43 to 49 do             {move face to above end of line (pos 50)}
  288.   begin
  289.   move(screen[16,k],screen[16,k + 1],1);  {move face 1 position to right}
  290.   screen[16,k + 1].attr := 6;             {maintain same face color}
  291.   fillchar(screen[16,k],1,0);             {blank out previous face}
  292.   update_screen(16,1);                    {update line 16}
  293.   delay(100);
  294.   end;
  295. move(screen[16,50],screen[17,50],1);      {move face down 1}
  296. screen[17,50].attr := 6;                  {maintain same face color}
  297. fillchar(screen[16,50],1,0);              {blank out previous face}
  298. update_screen(16,2);                      {update lines 16-17}
  299.  
  300. for k := 1 to 4 do     {move right half of line 4 positions left to }
  301.  begin                 {eliminate spaces}
  302.  for j := 44 to 50 do    {move 4 characters and face}
  303.   begin
  304.    screen[17,j - k] := screen[17,j - k + 1]; {move char 1 position left}
  305.    screen[17,j - k].attr := screen[17,j - k +1].attr; {maintain color}
  306.    fillchar(screen[17,j - k + 1],1,0);       {fill in behind face}
  307.    end;
  308.  update_screen(17,1);                     {update line 17}
  309.  end;
  310.  
  311. screen[18,46] := screen[17,46];           {move face down 1}
  312. screen[18,46].attr := screen[17,46].attr; {maintain color}
  313. fillchar(screen[17,46],1,0);              {fill in behind face}
  314. update_screen(17,2);                      {update lines 17-18}
  315. delay(200);
  316.  
  317. for k :=46 downto 44 do             {move face to "not"}
  318.   begin
  319.   move(screen[18,k],screen[18,k - 1],1);  {move face 1 position left}
  320.   screen[18,k - 1].attr := 6;             {maintain color}
  321.   fillchar(screen[18,k],1,0);             {fill in behind face}
  322.   delay(100);
  323.   update_screen(18,1);                    {update line 18}
  324.   end;
  325.  
  326. for k := 1 to 43 do       {move "not" off screen to left}
  327.   begin
  328.   for j := 1 to 44 do
  329.   begin
  330.   screen[18,j - k] := screen[18,j - k + 1];
  331.   screen[18,j - k + 1].attr := screen[18,j - k].attr;
  332.   end;
  333.   update_screen(18,1);
  334.   delay(100);
  335.   end;
  336.  
  337. {End FACE Routines}
  338. {--------------------------------------------------------------------------}
  339.   textcolor(red);
  340.   gotoxy(28,25);
  341.   write('(Press Any Key To Continue)');
  342.   read(kbd,ch);
  343.   read_screen(1,25);
  344.  
  345.   for i := 8 downto 1 do                       {Tilt banner}
  346.     begin
  347.     move(screen[i+8,1],screen[i + 8,11 - i],160);
  348.     fillchar(screen[i + 8,1],19 - (2 * i),0);
  349.     end;
  350.  
  351.   update_screen(8,8);
  352.   Delay(950);
  353.  
  354.   for k := 11 to 79 do                    {Remove banner}
  355.     begin
  356.     for j := 9 to 15 do
  357.       move(screen[j,k],screen[j,k + 1],160 - k * 2);
  358.     update_screen(8,8);
  359.     end;
  360.  
  361. end.